home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / WASTE 1.1a4 / Demo Source / WEDemoFiles.p < prev    next >
Encoding:
Text File  |  1994-11-13  |  7.0 KB  |  299 lines  |  [TEXT/PJMM]
  1. unit DemoFiles;
  2.  
  3. { WASTE DEMO PROJECT: }
  4. { File Handling }
  5.  
  6. { Copyright © 1993-1994 Merzwaren }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.     uses
  11.         DemoIntf;
  12.  
  13.     function ReadTextFile (pFileSpec: FSSpecPtr;
  14.                                     hWE: WEHandle): OSErr;
  15.     function WriteTextFile (pFileSpec: FSSpecPtr;
  16.                                     hWE: WEHandle): OSErr;
  17.     function TranslateDrag (theDrag: DragReference;
  18.                                     theItem: ItemReference;
  19.                                     requestedType: FlavorType;
  20.                                     dataHandle: Handle): OSErr;
  21.  
  22. implementation
  23.  
  24.     function ReadTextFile (pFileSpec: FSSpecPtr;
  25.                                     hWE: WEHandle): OSErr;
  26.         var
  27.             dataForkRefNum, resForkRefNum: Integer;
  28.             hText: Handle;
  29.             hStyleScrap: StScrpHandle;
  30.             fileSize: LongInt;
  31.  
  32.         procedure CleanUp;
  33.             var
  34.                 err: OSErr;
  35.         begin
  36.             if (hText <> nil) then
  37.                 begin
  38.                     DisposeHandle(hText);
  39.                     hText := nil;
  40.                 end;
  41.             if (dataForkRefNum <> 0) then
  42.                 begin
  43.                     err := FSClose(dataForkRefNum);
  44.                     dataForkRefNum := 0;
  45.                 end;
  46.             if (resForkRefNum <> 0) then
  47.                 begin
  48.                     CloseResFile(resForkRefNum);
  49.                     resForkRefNum := 0;
  50.                 end;
  51.         end;  { CleanUp }
  52.  
  53.         procedure CheckErr (err: OSErr);
  54.         begin
  55.             if (err <> noErr) then
  56.                 begin
  57.                     ReadTextFile := err;
  58.                     CleanUp;
  59.                     Exit(ReadTextFile);
  60.                 end;
  61.         end;  { CheckErr }
  62.  
  63.     begin
  64.         ReadTextFile := noErr;
  65.         dataForkRefNum := 0;
  66.         resForkRefNum := 0;
  67.         hText := nil;
  68.  
  69. { open the data fork with read-only permission }
  70.         CheckErr(FSpOpenDF(pFileSpec^, fsRdPerm, dataForkRefNum));
  71.  
  72. { get data fork size }
  73.         CheckErr(GetEOF(dataForkRefNum, fileSize));
  74.  
  75. { try to allocate a handle that large; use temporary memory if available }
  76.         CheckErr(NewHandleTemp(fileSize, hText));
  77.  
  78. { read in the text }
  79.         CheckErr(FSRead(dataForkRefNum, fileSize, hText^));
  80.  
  81. { install the text in the WE instance }
  82.         CheckErr(WEUseText(hText, hWE));
  83.         hText := nil;
  84.  
  85. { see if the file has a resource fork }
  86.         resForkRefNum := FSpOpenResFile(pFileSpec^, fsRdPerm);
  87.         if (resForkRefNum <> -1) then
  88.             begin
  89.  
  90. { look for a style scrap resource (get the first one; the resource ID doesn't matter) }
  91.                 hStyleScrap := StScrpHandle(Get1IndResource(kTypeStyles, 1));
  92.  
  93. { if there's a style scrap, apply it to the text }
  94.                 if (hStyleScrap <> nil) then
  95.                     begin
  96.                         WESetSelection(0, maxLongInt, hWE);
  97.                         CheckErr(WEUseStyleScrap(hStyleScrap, hWE));
  98.                         WESetSelection(0, 0, hWE);
  99.                     end;
  100.             end;
  101.  
  102. { clean up and exit }
  103.         CleanUp;
  104.  
  105.     end;  { ReadTextFile }
  106.  
  107.     function WriteTextFile (pFileSpec: FSSpecPtr;
  108.                                     hWE: WEHandle): OSErr;
  109.         var
  110.             dataForkRefNum, resForkRefNum: Integer;
  111.             hText, hStyles: Handle;
  112.             fileInfo: FInfo;
  113.             fileSize: LongInt;
  114.             replacing: Boolean;
  115.             err: OSErr;
  116.  
  117.         procedure CleanUp;
  118.             var
  119.                 err: OSErr;
  120.         begin
  121.  
  122.             if (dataForkRefNum <> 0) then
  123.                 begin
  124.                     err := FSClose(dataForkRefNum);
  125.                     dataForkRefNum := 0;
  126.                 end;
  127.  
  128.             if (hStyles <> nil) then
  129.                 begin
  130.                     ReleaseResource(hStyles);
  131.                     hStyles := nil;
  132.                 end;
  133.  
  134.             if (resForkRefNum <> 0) then
  135.                 begin
  136.                     CloseResFile(resForkRefNum);
  137.                     resForkRefNum := 0;
  138.                 end;
  139.  
  140.         end;  { CleanUp }
  141.  
  142.         procedure CheckErr (err: OSErr);
  143.         begin
  144.             if (err <> noErr) then
  145.                 begin
  146.                     WriteTextFile := err;
  147.                     ErrorAlert(err);
  148.                     CleanUp;
  149.                     Exit(WriteTextFile);
  150.                 end;
  151.         end;  { CheckErr }
  152.  
  153.     begin
  154.         WriteTextFile := noErr;
  155.         dataForkRefNum := 0;
  156.         resForkRefNum := 0;
  157.         hStyles := nil;
  158.  
  159. { are we replacing an existing file? }
  160.         err := FSpGetFInfo(pFileSpec^, fileInfo);
  161.         if (err = noErr) then
  162.             replacing := true
  163.         else if (err = fnfErr) then
  164.             replacing := false
  165.         else
  166.             CheckErr(err);
  167.  
  168. { delete existing file, if any }
  169.         if (replacing) then
  170.             CheckErr(FSpDelete(pFileSpec^));
  171.  
  172. { create a new file }
  173.         FSpCreateResFile(pFileSpec^, kAppSignature, kTypeText, 0);
  174.         CheckErr(ResError);
  175.  
  176. { if replacing an old file, copy the old file information }
  177.         if (replacing) then
  178.             CheckErr(FSpSetFInfo(pFileSpec^, fileInfo));
  179.  
  180. { open the data fork for writing }
  181.         CheckErr(FSpOpenDF(pFileSpec^, fsRdWrPerm, dataForkRefNum));
  182.  
  183. { get the text handle from the WE instance }
  184. { WEGetText returns the original handle, not a copy, so don't dispose of it! }
  185.         hText := WEGetText(hWE);
  186.         fileSize := GetHandleSize(hText);
  187.  
  188. { write the text }
  189.         CheckErr(FSWrite(dataForkRefNum, fileSize, hText^));
  190.  
  191. { open the resource file for writing }
  192.         resForkRefNum := FSpOpenResFile(pFileSpec^, fsRdWrPerm);
  193.         CheckErr(ResError);
  194.  
  195. { allocate a temporary handle to hold the style scrap }
  196.         CheckErr(NewHandleTemp(0, hStyles));
  197.  
  198. { create a style scrap describing the styles of the whole text }
  199.         CheckErr(WECopyRange(0, maxLongInt, nil, StScrpHandle(hStyles), nil, hWE));
  200.  
  201. { make the style scrap handle a resource handle }
  202.         AddResource(hStyles, kTypeStyles, 128, '');
  203.         CheckErr(ResError);
  204.  
  205. { write the style scrap to the resource file }
  206.         WriteResource(hStyles);
  207.         CheckErr(ResError);
  208.  
  209. { "clean" this document by resetting the WE instance modification count }
  210. { (this clears the undo buffer as well, so that undoing an editing action after saving }
  211. { doesn't set the modification count to a negative value) }
  212.         WEResetModCount(hWE);
  213.  
  214. { clean up }
  215.         CleanUp;
  216.  
  217.     end;  { WriteTextFile }
  218.  
  219.     function TranslateDrag (theDrag: DragReference;
  220.                                     theItem: ItemReference;
  221.                                     requestedType: FlavorType;
  222.                                     dataHandle: Handle): OSErr;
  223.  
  224. { this simple routine is meant to give an idea of how the drag translation hook ('xdrg') }
  225. { is supposed to work -- in the real world I should probably handle styled text files, }
  226. { PICT files and maybe other fancier file types here: }
  227. { that is left as an exercise for the reader }
  228.  
  229.         var
  230.             numFlavors: Integer;
  231.             theType: FlavorType;
  232.             hfs: HFSFlavor;
  233.             refNum: Integer;
  234.             dataSize: Size;
  235.             err: OSErr;
  236.  
  237.         procedure CleanUp;
  238.         begin
  239.             if (refNum <> 0) then
  240.                 begin
  241.                     if (FSClose(refNum) <> noErr) then
  242.                         ;
  243.                     refNum := 0;
  244.                 end;
  245.         end;  { CleanUp }
  246.  
  247.         procedure CheckErr (err: OSErr);
  248.         begin
  249.             if (err <> noErr) then
  250.                 begin
  251.                     TranslateDrag := err;
  252.                     CleanUp;
  253.                     Exit(TranslateDrag);
  254.                 end;
  255.         end;  { CheckErr }
  256.  
  257.     begin
  258.         TranslateDrag := badDragFlavorErr;        { assume failure }
  259.         refNum := 0;
  260.  
  261. { we'll try to translate HFS objects to TEXT, so make sure that is the requested type }
  262.         if (requestedType <> kTypeText) then
  263.             Exit(TranslateDrag);
  264.  
  265. { see if this drag item is a TEXT file }
  266.         dataSize := SizeOf(hfs);
  267.         if (CountDragItemFlavors(theDrag, theItem, numFlavors) = noErr) then
  268.             if (numFlavors = 1) then
  269.                 if (GetFlavorType(theDrag, theItem, 1, theType) = noErr) then
  270.                     if (theType = flavorTypeHFS) then
  271.                         if (GetFlavorData(theDrag, theItem, theType, @hfs, dataSize, 0) = noErr) then
  272.                             if (hfs.fileType = kTypeText) then
  273.                                 begin
  274.                                     TranslateDrag := noErr;        { assume success }
  275.  
  276. { if dataHandle is NIL, we're finished }
  277.                                     if (dataHandle = nil) then
  278.                                         Exit(TranslateDrag);
  279.  
  280. { open the file for reading }
  281.                                     CheckErr(FSpOpenDF(hfs.fileSpec, fsRdPerm, refNum));
  282.  
  283. { get file size }
  284.                                     CheckErr(GetEOF(refNum, dataSize));
  285.  
  286. { resize the data handle }
  287.                                     SetHandleSize(dataHandle, dataSize);
  288.                                     CheckErr(MemError);
  289.  
  290. { read the file }
  291.                                     CheckErr(FSRead(refNum, dataSize, dataHandle^));
  292.                                 end;
  293.  
  294. { clean up }
  295.         CleanUp;
  296.  
  297.     end;  { TranslateDrag }
  298.  
  299. end.